perm filename CLEFXG.F4[NEW,LCS]6 blob
sn#347596 filedate 1978-04-11 generic text, type T, neo UTF8
SUBROUTINE CLEFS
DIMENSION KPNT1(11),JCLEF(2100),RCMIN(4),KPNT2(11),KCLEF(350)
1,CM(4),LCLEF(350),KPNT3(11),MCLEF(350),NCLEF(350),ICLEF(350)
1,KPNT4(11),KPNT5(11),KPNT6(11),KPNT7(11),JJCLEF(350)
COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS,XDIS/BM/F,G,H
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /MIN/MINI,RMINI
DATA RCMIN/3.3,10.5,7.0,10.5/,CM/.1,1.5,1.1,1.5/
EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J9,JQ(7)),(KK,
1 KPNT2(11)),(R6,RJQ(4)),(R5,RJQ(3)),(R8,RJQ(6)),(R7,RJQ(5))
1,(DEG,R9,RJQ(7)),(NJR,RJQ(8)),(KJ,KPNT1(11)),(KCLEF,JCLEF(351))
1,(R3,RJQ(1)),(LCLEF,JCLEF(701)),(KL,KPNT3(11)),(KM,KPNT4(11))
1,(MCLEF,JCLEF(1051)),(NCLEF,JCLEF(1401)),(KN,KPNT5(11))
1,(KI,KPNT6(11)),(ICLEF,JCLEF(1751)),(KJJ,KPNT7(11))
1,(JJCLEF,JCLEF(2101)),(J8,JQ(6))
CX J5=MOD(J5,100)
CX IF(J5)J5=-J5
IF(R6.GE.100)R6=R6-100
C SOMETIMES MAKE SIZE +100 FOR PARTS PROGRAM.
CALL NOZERO(R6)
IF(R7.EQ.0)R7=R6
C IF P7 = 0, IT WILL EQUAL P6.
IF(JA.GT.10)GO TO 9
NAME='CLEFA'
IF(J5.LT.20)GO TO 4
R6=R6*.3
C SIZE FACTORS FOR SPECIAL WORDS, ETC. (PPP, MF, CRESC. ETC.)
R7=R7*.3
GO TO 4
9 IF(NAME.EQ.NJR)GO TO 4
IF(NAME.EQ.0)GO TO 177
IF(NJR.EQ.0)GO TO 4
177 IF(NJR.EQ.0)GO TO 8
C TO PICK UP BASIC DRAW NAME FROM P10
NAME=NJR
GO TO 4
8 TYPE 5
5 FORMAT(' SET P10=1'/)
C LEADS TO PROPER FILE CALL
4 JTAIL=-1
IF(JA.NE.3)GO TO 44
IF(R5.NE.0.8)GO TO 44
JTAIL=0
C R5=0.8 FOR TREBLE CLEF WITH 8 ON TAIL. (FOR TENOR VOCAL)
44 NM=NAME+2*(J5/10)
C DRAW0 HAS ITEMS 0→9; DRAW1, 10→19; ETC. TO DRAW9, 90→99
JEZ=MOD(J5,10)+1
2 IF(NM.EQ.NM1)GO TO 30
IF(NM.EQ.NM2)GO TO 30
IF(NM.EQ.NM3)GO TO 30
IF(NM.EQ.NM4)GO TO 30
IF(NM.EQ.NM5)GO TO 30
IF(NM.EQ.NM6)GO TO 30
IF(NM.EQ.NM7)GO TO 30
C SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
C JUMP IF ALREADY IN CORE
NPP=0
IF(JA.NE.11)GO TO 1111
C DOESN'T CHECK LOOKUP ON CLEFS AND ALPHA'S.
NPP=-1
IF(LOOKF(NM))GO TO 1111
TYPE 1112,NM
RETURN
1112 FORMAT(1XA5,' -- NOT FOUND')
KX=0
1111 CALL GETFI2(NM,NPP)
GO TO(33,233,333,433,533,633),KX
C GOES TO 133 WHEN KX IS 0
133 KX=1
NM1=NM
CALL FASTI2(KPNT1,11)
CALL FASTI2(JCLEF,KJ)
C NEW DATA READER 6/74 -- 5/75 HOLDS 3 .DMD FILES IF THEY FIT.
IF(KJ.LE.350)GO TO 30
KX=0
NM2=0
GO TO 30
33 CALL FASTI2(KPNT2,11)
IF(KK.GT.350)GO TO 1112
C JUMP BACK IF IT WON'T FIT.
CALL FASTI2(KCLEF,KK)
NM2=NM
KX=2
GO TO 30
233 CALL FASTI2(KPNT3,11)
IF(KL.GT.350)GO TO 1112
C JUMP BACK IF IT WON'T FIT.
CALL FASTI2(LCLEF,KL)
KX=3
NM3=NM
C CHECK THE ABOVE -- FOR P5 HEIGHT CHANGE *********************
C R6 IS SIZE FACTOR
GO TO 30
333 CALL FASTI2(KPNT4,11)
IF(KM.GT.350)GO TO 1112
C JUMP BACK IF IT WON'T FIT.
CALL FASTI2(MCLEF,KM)
KX=4
NM4=NM
GO TO 30
433 CALL FASTI2(KPNT5,11)
IF(KN.GT.350)GO TO 1112
C JUMP BACK IF IT WON'T FIT.
CALL FASTI2(NCLEF,KN)
KX=5
NM5=NM
GO TO 30
533 CALL FASTI2(KPNT6,11)
IF(KN.GT.350)GO TO 1112
C JUMP BACK IF IT WON'T FIT.
CALL FASTI2(ICLEF,KI)
KX=6
NM6=NM
GO TO 30
633 CALL FASTI2(KPNT7,11)
IF(KN.GT.350)GO TO 1112
C JUMP BACK IF IT WON'T FIT.
CALL FASTI2(JJCLEF,KJJ)
KX=0
NM7=NM
30 IF(J5.GT.3)GO TO 811
IF(JA.NE.3)GO TO 811
C 0=TREB, 1=BASS, 2=ALTO, 3=TENOR(ALTO SHIFTED UP) MINI→R4+100
C ↑↑↑↑↑↑↑↑ FIXUP SOMEDAY IN .DMD FILES
IF(IABS(J4).LT.80)GO TO 812
RSTJ2=.8*RSTJ2
C TO SET HGT. OF MINI CLEFS
R4=R4+CM(JEZ)
C SHIFTS MINIS UP BECAUSE OF WRONG ORIG. POS.??
812 IF(JEZ.NE.4)GO TO 811
R4=R4+2
JEZ=3
C ABOVE IS NOW AT TOP
811 A=R4
R4=A+2.9
C ADJUSTS HEIGHT(??)
CALL CENTX
R4=A
L=KPNT1(JEZ)
IF(NM.EQ.NM2)L=KPNT2(JEZ)+350
IF(NM.EQ.NM3)L=KPNT3(JEZ)+700
IF(NM.EQ.NM4)L=KPNT4(JEZ)+1050
IF(NM.EQ.NM5)L=KPNT5(JEZ)+1400
IF(NM.EQ.NM6)L=KPNT6(JEZ)+1750
IF(NM.EQ.NM7)L=KPNT7(JEZ)+2100
IF(L.LE.0)RETURN
C CATCHES IMPOSSIBLE NUMBERS (I HOPE!)
IF(J9.EQ.0)GO TO 31
C***** ROTATE *******
R7=R7*RSTJ2
R6=R6*RSTJ2
N=JCLEF(L)
KNT=701
C ROTATED DATA IS PUT STARTING AT LOCATION 701.(AREA FOR NM3)******
JCLEF(KNT)=N
DO 1 K=L+1,N+L-1
CALL UNPACK(J,M,JCLEF(K))
X=J*R6
Y=M*R7
JJ=JCLEF(K)/100000000
AX=ATAN2(X,Y)*57.29578
HYP=SQRT(X**2+Y**2)
ROT=DEG+AX
J=ROFF(HYP*COSD(ROT))
M=ROFF(HYP*SIND(ROT))
KNT=KNT+1
IF(J)J=1000-J
IF(M)M=1000-M
1 JCLEF(KNT)=M*10000+J+JJ*100000000
L=701
C *********** SEE AT TOP **********
R6=1.
R7=1.
RSTJ2=1.
C SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
CC CALL ROTATE(JCLEF,L)
NM3=0
C WIPES OUT DATA AREA FOR NM3
C R9=P9=DEGREES OF ROTATION (0-360)
IF(KK.GT.350)KX=0
C CHECK TO SEE IF DATA WAS WIPED OUT.
31 A=-1
C FLAG FOR THICKNESS OR NO.
IF(J8.EQ.-2)GO TO 32
IF(R8.LE.0)GO TO 34
A=0
C NEXT J8 = 1→99 =X THICKNESS, =100→ = Y THICKNESS
CALL THICK
C SEE CLEFZ.F4 FOR "THICK" CODE (THICK IS IN MFAIL.FAI)
GO TO 32
CC34 IF(IPLT)GO TO 77
CC31 IF(R8.EQ.-2)GO TO 32
C R8=-2 OMITS FILLER DURING PLOT
CCC IF(IPLT)GO TO 77
34 IF(IPLT)77,77,32
CCCC IF(R8.NE.-1)GO TO 32
77 DO 3 K=L+1,JCLEF(L)+L
IF(JCLEF(K).LT.200000000)GO TO 3
JEZ=JCLEF(L)-1
IF(K.GT.L+1)JEZ=JEZ-K+L+1
CALL FILLMS(JEZ,JCLEF(K),R3,CENTR,R6,R7)
GO TO 32
3 CONTINUE
C FILLS ONLY WHEN PLOTING OR R8=-1
32 CALL JDRAW(JCLEF(L),R3,CENTR,RSTJ2,R6,R7)
C 3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, R8=-1 TO FILL ON CRT
IF(A)GO TO 334
IF(J8.NE.0)GO TO 234
IF(J9.EQ.0)GO TO 334
GO TO 134
234 J8=J8-1
R3=R3+XDIS
C XDIS=1 PLOTTER STEP NO MATTER WHAT SIZE FACTOR USED
134 IF(J9.EQ.0)GO TO 32
J9=J9-1
CENTR=CENTR+XDIS
GO TO 32
334 IF(JTAIL)RETURN
JTAIL=-1
JA=10
JEZ=9
C JEZ=9 MAKES AN 8 APPEAR UNDER TAIL OF TREBLE CLEF.
R6=.2
R7=R6
NM='BDR40'
R3=R3+14*RSTJ2
R4=-4
GO TO 2
END